home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / dctran.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  60KB  |  1,913 lines
  1. /* dctran.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas, 
  26.         rstats[50];
  27.     integer iwidth, lwidth, nopage;
  28. } miscel_;
  29.  
  30. #define miscel_1 miscel_
  31.  
  32. struct {
  33.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  34.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  35. } cirdat_;
  36.  
  37. #define cirdat_1 cirdat_
  38.  
  39. struct {
  40.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  41.         sfactr;
  42.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  43.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  44. } status_;
  45.  
  46. #define status_1 status_
  47.  
  48. struct {
  49.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  50.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  51. } flags_;
  52.  
  53. #define flags_1 flags_
  54.  
  55. struct {
  56.     doublereal tcstar[2], tcstop[2], tcincr[2];
  57.     integer icvflg, itcelm[2], kssop, kinel, kidin, kovar, kidout;
  58. } dc_;
  59.  
  60. #define dc_1 dc_
  61.  
  62. struct {
  63.     doublereal tstep, tstop, tstart, delmax, tdmax, forfre;
  64.     integer jtrflg;
  65. } tran_;
  66.  
  67. #define tran_1 tran_
  68.  
  69. struct {
  70.     integer maxtim, itime, icost;
  71. } cje_;
  72.  
  73. #define cje_1 cje_
  74.  
  75. struct {
  76.     doublereal value[200000];
  77. } blank_;
  78.  
  79. #define blank_1 blank_
  80.  
  81. /* Table of constant values */
  82.  
  83. static integer c__1 = 1;
  84. static integer c__0 = 0;
  85. static integer c_n1 = -1;
  86. static integer c__2 = 2;
  87. static integer c__7 = 7;
  88. static integer c__6 = 6;
  89.  
  90. /* spice version 2g.6  sccsid=dctran.ma 3/15/83 */
  91. /*<       subroutine dctran >*/
  92. /* Subroutine */ int dctran_()
  93. {
  94.     /* Initialized data */
  95.  
  96.     static struct {
  97.     char e_1[8];
  98.     doublereal e_2;
  99.     } equiv_93 = { {'r', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  100.  
  101. #define aletr (*(doublereal *)&equiv_93)
  102.  
  103.     static struct {
  104.     char e_1[8];
  105.     doublereal e_2;
  106.     } equiv_94 = { {'t', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  107.  
  108. #define alett (*(doublereal *)&equiv_94)
  109.  
  110.     static struct {
  111.     char e_1[24];
  112.     doublereal e_2;
  113.     } equiv_95 = { {'(', ' ', '(', '2', 'x', ',', 'a', '4', ',', '3', 'x',
  114.          ',', 'a', '7', ',', '3', 'x', ')', '/', '/', ')', ' ', ' ', 
  115.         ' '}, 0. };
  116.  
  117. #define avhdr ((doublereal *)&equiv_95)
  118.  
  119.     static struct {
  120.     char e_1[32];
  121.     doublereal e_2;
  122.     } equiv_96 = { {'(', ' ', '(', '1', 'h', ' ', ',', 'a', '1', ',', 'i',
  123.          '3', ',', '1', 'h', ')', ',', 'f', '1', '0', '.', '4', ',', 
  124.         '3', 'x', ')', '/', ')', ' ', ' ', ' ', ' '}, 0. };
  125.  
  126. #define avfrm ((doublereal *)&equiv_96)
  127.  
  128.     static struct {
  129.     char e_1[8];
  130.     doublereal e_2;
  131.     } equiv_97 = { {'n', 'o', 'd', 'e', ' ', ' ', ' ', ' '}, 0. };
  132.  
  133. #define anode (*(doublereal *)&equiv_97)
  134.  
  135.     static struct {
  136.     char e_1[8];
  137.     doublereal e_2;
  138.     } equiv_98 = { {'v', 'o', 'l', 't', 'a', 'g', 'e', ' '}, 0. };
  139.  
  140. #define avltg (*(doublereal *)&equiv_98)
  141.  
  142.     static struct {
  143.     char e_1[64];
  144.     doublereal e_2;
  145.     } equiv_99 = { {'s', 'm', 'a', 'l', 'l', ' ', 's', 'i', 'g', 'n', 'a',
  146.          'l', ' ', 'b', 'i', 'a', 's', ' ', 's', 'o', 'l', 'u', 't', 
  147.         'i', 'o', 'n', ' ', ' ', ' ', ' ', ' ', ' ', 'i', 'n', 'i', 
  148.         't', 'i', 'a', 'l', ' ', 't', 'r', 'a', 'n', 's', 'i', 'e', 
  149.         'n', 't', ' ', 's', 'o', 'l', 'u', 't', 'i', 'o', 'n', ' ', 
  150.         ' ', ' ', ' ', ' ', ' '}, 0. };
  151.  
  152. #define subtit ((doublereal *)&equiv_99)
  153.  
  154.     static struct {
  155.     char e_1[4];
  156.     integer e_2;
  157.     } equiv_100 = { {'(', ' ', ' ', ' '}, 0 };
  158.  
  159. #define lprn (*(integer *)&equiv_100)
  160.  
  161.     static struct {
  162.     char e_1[8];
  163.     doublereal e_2;
  164.     } equiv_101 = { {' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  165.  
  166. #define ablnk (*(doublereal *)&equiv_101)
  167.  
  168.  
  169.     /* Format strings */
  170.     static char fmt_26[] = "(\0020insufficient memory available for dc analy\
  171. sis.\002,/\002 memory required \002,i6,\002, memory available \002,i6,\002\
  172. .\002)";
  173.     static char fmt_151[] = "(\0021*error*:  no convergence in dc analysi\
  174. s\002/\0020last node vol\002,\002tages:\002/)";
  175.     static char fmt_451[] = "(\0021*error*:  no convergence in dc transfer c\
  176. urves at \002,a8,\002 = \002,1pd10.3/\0020last node voltages:\002/)";
  177.     static char fmt_461[] = "(\0020*error*:  cpu time limit exceeded ... ana\
  178. lysis stopped\002/)";
  179.     static char fmt_463[] = "(\0020*error*:   temperature sweep should be th\
  180. e second sweep  source, change the order and re-execute\002/)";
  181.     static char fmt_492[] = "(/,\0020*****0 return to original temperature 0\
  182. *****0\002,/)";
  183.     static char fmt_901[] = "(\0021*error*:  internal timestep too small in \
  184. transient analysis\002/)";
  185.     static char fmt_906[] = "(\0021*error*:  transient analysis iterations e\
  186. xceed limit of \002,i5,/\0020this limit may be overridden using the itl5 par\
  187. ameter on the .option card\002)";
  188.     static char fmt_911[] = "(\0020\002,10x,\002time = \002,1pd12.5,\002;  d\
  189. elta = \002,d12.5,\002;  numnit = \002,i6/)";
  190.     static char fmt_916[] = "(\0020\002/\0020last node voltages:\002/)";
  191.     static char fmt_921[] = "(\0020*error*:  cpu time limit exceeded in tran\
  192. sient analysis \002,\002at time = \002,1pd13.6/)";
  193.  
  194.     /* System generated locals */
  195.     integer i_1, i_2;
  196.     doublereal d_1, d_2;
  197.  
  198.     /* Builtin functions */
  199.     integer s_wsfe(), do_fio(), e_wsfe();
  200.  
  201.     /* Local variables */
  202.     static integer need;
  203.     static doublereal anam;
  204.     static integer loce;
  205.     extern /* Subroutine */ int jfet_();
  206.     static integer loco, jord, navl, locs, ipos;
  207.     extern /* Subroutine */ int move_();
  208.     static doublereal temp;
  209.     static integer iptr, locv, ical2, node1, node2, node3, node4, locs2;
  210.     extern /* Subroutine */ int getm8_(), avlm8_(), iter8_();
  211.     static doublereal temv2;
  212.     static integer nolx2, nolx3;
  213.     extern /* Subroutine */ int copy8_();
  214.     static integer i, ibuff;
  215.     extern /* Subroutine */ int diode_();
  216.     static integer itemp;
  217.     extern /* Subroutine */ int title_();
  218.     static doublereal t1;
  219.     static integer numtp, nbkpt;
  220.     extern /* Subroutine */ int trunc_();
  221.     static integer numtd, lcntr, ltemp;
  222.     static doublereal z0;
  223.     static integer lspot;
  224.     static doublereal t2;
  225.     static integer icvfl1, icvfl2, irdct2, itdct2, ibkflg;
  226.     extern /* Subroutine */ int getcje_();
  227.     static doublereal delbkp;
  228.     extern /* Subroutine */ int pheadr_(), comcof_();
  229. #define nodplc ((integer *)&blank_1)
  230. #define cvalue ((complex *)&blank_1)
  231.     extern logical memptr_();
  232.     extern /* Subroutine */ int second_();
  233.     static integer loctim, numcur, numpos, loc, loccur, nvprln;
  234.     extern /* Subroutine */ int alfnum_(), slpmem_(), crunch_(), sorupd_(), 
  235.         sorstp_(), bjt_(), mosfet_();
  236.     static integer numout, irdctc, itdctc;
  237.     static doublereal temval;
  238.     extern /* Subroutine */ int tmpupd_(), extmem_(), fwrite_(), ptrmem_(), 
  239.         relmem_();
  240.     static integer numese, numrtp, numnit;
  241.     static doublereal delnew, delmin;
  242.     static integer itrlim;
  243.     extern /* Subroutine */ int clrmem_();
  244.     static doublereal ordrat;
  245.     extern /* Subroutine */ int sizmem_();
  246.     static integer ltdsiz;
  247.     static doublereal baktim;
  248.     static integer nwords, ltdptr, ibr1, ibr2;
  249.     static doublereal del1;
  250.     extern /* Subroutine */ int clsraw_();
  251.  
  252.     /* Fortran I/O blocks */
  253.     static cilist io__25 = { 0, 0, 0, fmt_26, 0 };
  254.     static cilist io__26 = { 0, 0, 0, (char *)avhdr, 0 };
  255.     static cilist io__28 = { 0, 0, 0, (char *)avfrm, 0 };
  256.     static cilist io__29 = { 0, 0, 0, fmt_151, 0 };
  257.     static cilist io__30 = { 0, 0, 0, (char *)avhdr, 0 };
  258.     static cilist io__31 = { 0, 0, 0, (char *)avfrm, 0 };
  259.     static cilist io__52 = { 0, 0, 0, fmt_451, 0 };
  260.     static cilist io__53 = { 0, 0, 0, (char *)avhdr, 0 };
  261.     static cilist io__54 = { 0, 0, 0, (char *)avfrm, 0 };
  262.     static cilist io__55 = { 0, 0, 0, fmt_461, 0 };
  263.     static cilist io__56 = { 0, 0, 0, fmt_463, 0 };
  264.     static cilist io__57 = { 0, 0, 0, fmt_492, 0 };
  265.     static cilist io__85 = { 0, 0, 0, fmt_901, 0 };
  266.     static cilist io__86 = { 0, 0, 0, fmt_906, 0 };
  267.     static cilist io__87 = { 0, 0, 0, fmt_911, 0 };
  268.     static cilist io__88 = { 0, 0, 0, fmt_916, 0 };
  269.     static cilist io__89 = { 0, 0, 0, (char *)avhdr, 0 };
  270.     static cilist io__90 = { 0, 0, 0, (char *)avfrm, 0 };
  271.     static cilist io__91 = { 0, 0, 0, fmt_921, 0 };
  272.  
  273.  
  274. /*<       implicit double precision (a-h,o-z) >*/
  275.  
  276.  
  277. /*     this routine controls the dc transfer curve, dc operating point, */
  278.  
  279. /* and transient analyses.  the variables mode and modedc (defined below) 
  280. */
  281. /* determine exactly which analysis is performed. */
  282.  
  283. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  284. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  285. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  286. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  287. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  288. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  289. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  290. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  291. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  292. /* spice version 2g.6  sccsid=miscel 3/15/83 */
  293. /*<       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
  294. /*<      1  defas,rstats(50),iwidth,lwidth,nopage >*/
  295. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  296. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  297. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  298. /* spice version 2g.6  sccsid=status 3/15/83 */
  299. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  300. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  301. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  302. /* spice version 2g.6  sccsid=flags 3/15/83 */
  303. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  304. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  305. /* spice version 2g.6  sccsid=dc 3/15/83 */
  306. /*<       common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop, >*/
  307. /*<      1   kinel,kidin,kovar,kidout >*/
  308. /* spice version 2g.6  sccsid=tran 3/15/83 */
  309. /*<       common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg >*/
  310. /* spice version 2g.6  sccsid=cje 3/15/83 */
  311. /*<       common /cje/ maxtim,itime,icost >*/
  312. /* spice version 2g.6  sccsid=blank 3/15/83 */
  313. /*<       common /blank/ value(200000) >*/
  314. /*<       integer nodplc(64) >*/
  315. /*<       complex cvalue(32) >*/
  316. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  317. /*<       logical memptr >*/
  318.  
  319.  
  320. /*<       dimension subtit(4,2) >*/
  321. /*<       dimension avhdr(3),avfrm(4) >*/
  322. /*<       data avhdr / 8h( (2x,a4, 8h,3x,a7,3, 5hx)//) / >*/
  323. /*<       data avfrm / 8h( (1h ,a, 8h1,i3,1h), 8h,f10.4,3, 4hx)/) / >*/
  324. /*<       data anode, avltg / 4hnode, 7hvoltage / >*/
  325. /*<       data subtit / 8hsmall si, 8hgnal bia, 8hs soluti, 8hon      , >*/
  326. /*<      1              8hinitial , 8htransien, 8ht soluti, 8hon      / >*/
  327. /*<       data lprn /1h(/ >*/
  328. /*<       data ablnk, aletr, alett /1h , 1hr, 1ht / >*/
  329.  
  330. /*      the variables *mode*, *modedc*, and *initf* are used by spice to 
  331. */
  332. /* keep track of the state of the analysis.  the values of these flags */
  333. /* (and the corresponding meanings) are as follows: */
  334.  
  335. /*        flag    value    meaning */
  336. /*        ----    -----    ------- */
  337.  
  338. /*        mode      1      dc analysis (subtype defined by *modedc*) */
  339. /*                  2      transient analysis */
  340. /*                  3      ac analysis (small signal) */
  341.  
  342. /*        modedc    1      dc operating point */
  343. /*                  2      initial operating point for transient analysis 
  344. */
  345. /*                  3      dc transfer curve computation */
  346.  
  347. /*        initf     1      converge with 'off' devices allowed to float */
  348.  
  349. /*                  2      initialize junction voltages */
  350. /*                  3      converge with 'off' devices held 'off' */
  351. /*                  4      store small-signal parameters away */
  352. /*                  5      first timepoint in transient analysis */
  353. /*                  6      prediction step */
  354.  
  355. /* note:  *modedc* is only significant if *mode* = 1. */
  356.  
  357.  
  358. /*  initialize */
  359.  
  360. /*<       call second(t1) >*/
  361.     second_(&t1);
  362. /*<       sfactr=1.0d0 >*/
  363.     status_1.sfactr = 1.;
  364. /* .. don't take any chances with lx3, set to large number */
  365. /*<       lx3=20000000 >*/
  366.     tabinf_1.lx3 = 20000000;
  367. /*<       lx2=20000000 >*/
  368.     tabinf_1.lx2 = 20000000;
  369. /* .. see if lx3 and lx2 tables are needed */
  370. /*<       nolx2=0 >*/
  371.     nolx2 = 0;
  372. /*<       nolx3=0 >*/
  373.     nolx3 = 0;
  374. /*<    20 loctim=5 >*/
  375. /* L20: */
  376.     loctim = 5;
  377.  
  378. /* .. post-processing initialization */
  379.  
  380. /*<       if(ipostp.eq.0) go to 25 >*/
  381.     if (status_1.ipostp == 0) {
  382.     goto L25;
  383.     }
  384. /*<       numcur=jelcnt(9) >*/
  385.     numcur = cirdat_1.jelcnt[8];
  386. /*<       numpos=nunods+numcur >*/
  387.     numpos = cirdat_1.nunods + numcur;
  388. /*<       call getm8(ibuff,numpos) >*/
  389.     getm8_(&ibuff, &numpos);
  390. /*<       numpos=numpos*4 >*/
  391.     numpos <<= 2;
  392. /*<       if(numcur.eq.0) go to 25 >*/
  393.     if (numcur == 0) {
  394.     goto L25;
  395.     }
  396. /*<       loc=locate(9) >*/
  397.     loc = cirdat_1.locate[8];
  398. /*<       loccur=nodplc(loc+6)-1 >*/
  399.     loccur = nodplc[loc + 5] - 1;
  400.  
  401. /* ...  set up format */
  402.  
  403. /*<    25 nvprln=4+(lwidth-72)/19 >*/
  404. L25:
  405.     nvprln = (miscel_1.lwidth - 72) / 19 + 4;
  406. /*<       nvprln=min0(nvprln,ncnods-1) >*/
  407. /* Computing MAX */
  408.     i_1 = nvprln, i_2 = cirdat_1.ncnods - 1;
  409.     nvprln = min(i_2,i_1);
  410. /*<       ipos=2 >*/
  411.     ipos = 2;
  412. /*<       call alfnum(nvprln,avfrm,ipos) >*/
  413.     alfnum_(&nvprln, avfrm, &ipos);
  414. /*<       ipos=2 >*/
  415.     ipos = 2;
  416. /*<       call alfnum(nvprln,avhdr,ipos) >*/
  417.     alfnum_(&nvprln, avhdr, &ipos);
  418. /* ...  allocate storage */
  419. /*<       if (mode.eq.2) go to 35 >*/
  420.     if (status_1.mode == 2) {
  421.     goto L35;
  422.     }
  423. /*<       need=4*nstop+nttbr+nxtrm >*/
  424.     need = (cirdat_1.nstop << 2) + tabinf_1.nttbr + cirdat_1.nxtrm;
  425. /*<       call avlm8(navl) >*/
  426.     avlm8_(&navl);
  427. /*<       if(need.le.navl) go to 30 >*/
  428.     if (need <= navl) {
  429.     goto L30;
  430.     }
  431. /* ...  not enough memory for dc operating point analysis */
  432. /*<       write(iofile,26) need,navl >*/
  433.     io__25.ciunit = status_1.iofile;
  434.     s_wsfe(&io__25);
  435.     do_fio(&c__1, (char *)&need, (ftnlen)sizeof(integer));
  436.     do_fio(&c__1, (char *)&navl, (ftnlen)sizeof(integer));
  437.     e_wsfe();
  438. /*<    26 format('0insufficient memory available for dc analysis.',/ >*/
  439. /*<      1' memory required ',i6,', memory available ',i6,'.') >*/
  440. /*<       nogo=1 >*/
  441.     flags_1.nogo = 1;
  442. /*<       go to 1100 >*/
  443.     goto L1100;
  444. /*<    30 call getm8(lvnim1,nstop) >*/
  445. L30:
  446.     getm8_(&tabinf_1.lvnim1, &cirdat_1.nstop);
  447. /*<       call getm8(lvn,nstop+nttbr) >*/
  448.     i_1 = cirdat_1.nstop + tabinf_1.nttbr;
  449.     getm8_(&tabinf_1.lvn, &i_1);
  450. /*<       call slpmem(lvn,nstop) >*/
  451.     slpmem_(&tabinf_1.lvn, &cirdat_1.nstop);
  452. /*<       call getm8(lx0,nxtrm) >*/
  453.     getm8_(&tabinf_1.lx0, &cirdat_1.nxtrm);
  454. /*<       call getm8(lvntmp,nstop) >*/
  455.     getm8_(&tabinf_1.lvntmp, &cirdat_1.nstop);
  456. /*<       if (modedc.ne.3) go to 45 >*/
  457.     if (status_1.modedc != 3) {
  458.     goto L45;
  459.     }
  460. /*<    35 call getm8(lx1,nxtrm) >*/
  461. L35:
  462.     getm8_(&tabinf_1.lx1, &cirdat_1.nxtrm);
  463. /*<       if(nolx2.eq.0) call getm8(lx2,nxtrm) >*/
  464.     if (nolx2 == 0) {
  465.     getm8_(&tabinf_1.lx2, &cirdat_1.nxtrm);
  466.     }
  467. /*<       if (mode.ne.2) go to 40 >*/
  468.     if (status_1.mode != 2) {
  469.     goto L40;
  470.     }
  471. /*<       if(nolx3.eq.0) call getm8(lx3,nxtrm) >*/
  472.     if (nolx3 == 0) {
  473.     getm8_(&tabinf_1.lx3, &cirdat_1.nxtrm);
  474.     }
  475. /*<       call getm8(ltd,0) >*/
  476.     getm8_(&tabinf_1.ltd, &c__0);
  477. /*<    40 call getm8(loutpt,0) >*/
  478. L40:
  479.     getm8_(&tabinf_1.loutpt, &c__0);
  480. /*<    45 call crunch >*/
  481. L45:
  482.     crunch_();
  483. /*<    50 if (mode.eq.2) go to 500 >*/
  484. /* L50: */
  485.     if (status_1.mode == 2) {
  486.     goto L500;
  487.     }
  488. /*<       time=0.0d0 >*/
  489.     status_1.time = 0.;
  490. /*<       ag(1)=0.0d0 >*/
  491.     status_1.ag[0] = 0.;
  492. /*<       call sorupd >*/
  493.     sorupd_();
  494. /*<       if (modedc.eq.3) go to 300 >*/
  495.     if (status_1.modedc == 3) {
  496.     goto L300;
  497.     }
  498.  
  499.  
  500. /*  ....  single point dc analysis */
  501.  
  502.  
  503. /*  compute dc operating point */
  504.  
  505. /*<   100 if (itl6.gt.0) go to 105 >*/
  506. /* L100: */
  507.     if (flags_1.itl6 > 0) {
  508.     goto L105;
  509.     }
  510. /*<       initf=2 >*/
  511.     status_1.initf = 2;
  512. /*<       call iter8(itl1) >*/
  513.     iter8_(&flags_1.itl1);
  514. /*<       rstats(6)=rstats(6)+iterno >*/
  515.     miscel_1.rstats[5] += status_1.iterno;
  516. /*<       if (igoof.ne.0) go to 150 >*/
  517.     if (flags_1.igoof != 0) {
  518.     goto L150;
  519.     }
  520. /*<       go to 110 >*/
  521.     goto L110;
  522. /*<   105 call sorstp(itl6) >*/
  523. L105:
  524.     sorstp_(&flags_1.itl6);
  525. /*<       rstats(6)=rstats(6)+iterno >*/
  526.     miscel_1.rstats[5] += status_1.iterno;
  527. /*<       if (igoof.ne.0) go to 150 >*/
  528.     if (flags_1.igoof != 0) {
  529.     goto L150;
  530.     }
  531. /*<   110 if (modedc.ne.1) go to 120 >*/
  532. L110:
  533.     if (status_1.modedc != 1) {
  534.     goto L120;
  535.     }
  536. /*<       initf=4 >*/
  537.     status_1.initf = 4;
  538. /*<       call diode >*/
  539.     diode_();
  540. /*<       call bjt >*/
  541.     bjt_();
  542. /*<       call jfet >*/
  543.     jfet_();
  544. /*<       call mosfet >*/
  545.     mosfet_();
  546.  
  547. /*  print operating point */
  548.  
  549. /*<   120 if ((mode.eq.1).and.(modedc.eq.2).and.(nosolv.ne.0)) go to 1000 >*/
  550. L120:
  551.     if (status_1.mode == 1 && status_1.modedc == 2 && status_1.nosolv != 0) {
  552.     goto L1000;
  553.     }
  554. /*<       call title(-1,lwidth,1,subtit(1,modedc)) >*/
  555.     title_(&c_n1, &miscel_1.lwidth, &c__1, &subtit[(status_1.modedc << 2) - 4]
  556.         );
  557. /*<       write (iofile,avhdr) (anode,avltg,i=1,nvprln) >*/
  558.     io__26.ciunit = status_1.iofile;
  559.     s_wsfe(&io__26);
  560.     i_1 = nvprln;
  561.     for (i = 1; i <= i_1; ++i) {
  562.     do_fio(&c__1, (char *)&anode, (ftnlen)sizeof(doublereal));
  563.     do_fio(&c__1, (char *)&avltg, (ftnlen)sizeof(doublereal));
  564.     }
  565.     e_wsfe();
  566. /*<       write (iofile,avfrm) (lprn,nodplc(junode+i),value(lvnim1+i), >*/
  567. /*<      1  i=2,ncnods) >*/
  568.     io__28.ciunit = status_1.iofile;
  569.     s_wsfe(&io__28);
  570.     i_1 = cirdat_1.ncnods;
  571.     for (i = 2; i <= i_1; ++i) {
  572.     do_fio(&c__1, (char *)&lprn, (ftnlen)sizeof(integer));
  573.     do_fio(&c__1, (char *)&nodplc[tabinf_1.junode + i - 1], (ftnlen)
  574.         sizeof(integer));
  575.     do_fio(&c__1, (char *)&blank_1.value[tabinf_1.lvnim1 + i - 1], (
  576.         ftnlen)sizeof(doublereal));
  577.     }
  578.     e_wsfe();
  579. /*<       go to 1000 >*/
  580.     goto L1000;
  581.  
  582. /*  no convergence */
  583.  
  584. /*<   150 nogo=1 >*/
  585. L150:
  586.     flags_1.nogo = 1;
  587. /*<       write (iofile,151) >*/
  588.     io__29.ciunit = status_1.iofile;
  589.     s_wsfe(&io__29);
  590.     e_wsfe();
  591. /*<   151 format('1*error*:  no convergence in dc analysis'/'0last node vol' >*/
  592. /*<      1   ,'tages:'/) >*/
  593. /*<       write (iofile,avhdr) (anode,avltg,i=1,nvprln) >*/
  594.     io__30.ciunit = status_1.iofile;
  595.     s_wsfe(&io__30);
  596.     i_1 = nvprln;
  597.     for (i = 1; i <= i_1; ++i) {
  598.     do_fio(&c__1, (char *)&anode, (ftnlen)sizeof(doublereal));
  599.     do_fio(&c__1, (char *)&avltg, (ftnlen)sizeof(doublereal));
  600.     }
  601.     e_wsfe();
  602. /*<       write (iofile,avfrm) (lprn,nodplc(junode+i),value(lvnim1+i), >*/
  603. /*<      1  i=2,ncnods) >*/
  604.     io__31.ciunit = status_1.iofile;
  605.     s_wsfe(&io__31);
  606.     i_1 = cirdat_1.ncnods;
  607.     for (i = 2; i <= i_1; ++i) {
  608.     do_fio(&c__1, (char *)&lprn, (ftnlen)sizeof(integer));
  609.     do_fio(&c__1, (char *)&nodplc[tabinf_1.junode + i - 1], (ftnlen)
  610.         sizeof(integer));
  611.     do_fio(&c__1, (char *)&blank_1.value[tabinf_1.lvnim1 + i - 1], (
  612.         ftnlen)sizeof(doublereal));
  613.     }
  614.     e_wsfe();
  615. /*<       go to 1000 >*/
  616.     goto L1000;
  617.  
  618. /*  ....  dc transfer curves */
  619.  
  620. /*<   300 numout=jelcnt(41)+1 >*/
  621. L300:
  622.     numout = cirdat_1.jelcnt[40] + 1;
  623. /*<       if(ipostp.ne.0) call pheadr(atitle) >*/
  624.     if (status_1.ipostp != 0) {
  625.     pheadr_(miscel_1.atitle);
  626.     }
  627. /*<       itemp=itcelm(1) >*/
  628.     itemp = dc_1.itcelm[0];
  629. /*<       locs=nodplc(itemp+1) >*/
  630.     locs = nodplc[itemp];
  631. /*<       anam=value(locs) >*/
  632.     anam = blank_1.value[locs - 1];
  633. /*<       call move(anam,2,ablnk,1,7) >*/
  634.     move_(&anam, &c__2, &ablnk, &c__1, &c__7);
  635. /*<       irdctc=0 >*/
  636.     irdctc = 0;
  637. /*<       irdct2=0 >*/
  638.     irdct2 = 0;
  639. /*<       itdctc=0 >*/
  640.     itdctc = 0;
  641. /*<       itdct2=0 >*/
  642.     itdct2 = 0;
  643. /*<       if (anam.eq.aletr) irdctc=1 >*/
  644.     if (anam == aletr) {
  645.     irdctc = 1;
  646.     }
  647. /*<       if (anam.eq.alett) itdctc=1 >*/
  648.     if (anam == alett) {
  649.     itdctc = 1;
  650.     }
  651. /*<       temval=value(locs+1) >*/
  652.     temval = blank_1.value[locs];
  653. /*<       icvfl2=1 >*/
  654.     icvfl2 = 1;
  655. /*<       if(itcelm(2).eq.0) go to 310 >*/
  656.     if (dc_1.itcelm[1] == 0) {
  657.     goto L310;
  658.     }
  659. /*<       itemp=itcelm(2) >*/
  660.     itemp = dc_1.itcelm[1];
  661. /*<       locs2=nodplc(itemp+1) >*/
  662.     locs2 = nodplc[itemp];
  663. /*<       anam=value(locs2) >*/
  664.     anam = blank_1.value[locs2 - 1];
  665. /*<       call move(anam,2,ablnk,1,7) >*/
  666.     move_(&anam, &c__2, &ablnk, &c__1, &c__7);
  667. /*<       if (anam.eq.aletr) irdct2=1 >*/
  668.     if (anam == aletr) {
  669.     irdct2 = 1;
  670.     }
  671. /*<       if (anam.eq.alett) itdct2=1 >*/
  672.     if (anam == alett) {
  673.     itdct2 = 1;
  674.     }
  675. /*<       temv2=value(locs2+1) >*/
  676.     temv2 = blank_1.value[locs2];
  677. /*<       value(locs2+1)=tcstar(2) >*/
  678.     blank_1.value[locs2] = dc_1.tcstar[1];
  679. /*<       temp=dabs((tcstop(2)-tcstar(2))/tcincr(2))+0.5d0 >*/
  680.     temp = (d_1 = (dc_1.tcstop[1] - dc_1.tcstar[1]) / dc_1.tcincr[1], abs(d_1)
  681.         ) + .5;
  682. /*<       icvfl2=idint(temp)+1 >*/
  683.     icvfl2 = (integer) temp + 1;
  684. /*<       icvfl2=max0(icvfl2,1) >*/
  685.     icvfl2 = max(icvfl2,1);
  686. /*<   310 delta=tcincr(1) >*/
  687. L310:
  688.     status_1.delta = dc_1.tcincr[0];
  689. /*<       do 320 i=1,7 >*/
  690.     for (i = 1; i <= 7; ++i) {
  691. /*<       delold(i)=delta >*/
  692.     status_1.delold[i - 1] = status_1.delta;
  693. /*<   320 continue >*/
  694. /* L320: */
  695.     }
  696. /*<       icvfl1=icvflg/icvfl2 >*/
  697.     icvfl1 = dc_1.icvflg / icvfl2;
  698. /*<       value(locs+1)=tcstar(1) >*/
  699.     blank_1.value[locs] = dc_1.tcstar[0];
  700. /*<       if ((itdctc.ne.1).and.(itdct2.ne.1)) go to 325 >*/
  701.     if (itdctc != 1 && itdct2 != 1) {
  702.     goto L325;
  703.     }
  704. /*<       itemno=3 >*/
  705.     status_1.itemno = 3;
  706. /*<       if (itdctc.eq.1) value(itemps+itemno)=value(locs+1) >*/
  707.     if (itdctc == 1) {
  708.     blank_1.value[tabinf_1.itemps + status_1.itemno - 1] = blank_1.value[
  709.         locs];
  710.     }
  711. /*<       if (itdct2.eq.1) value(itemps+itemno)=value(locs2+1) >*/
  712.     if (itdct2 == 1) {
  713.     blank_1.value[tabinf_1.itemps + status_1.itemno - 1] = blank_1.value[
  714.         locs2];
  715.     }
  716. /*<       call tmpupd >*/
  717.     tmpupd_();
  718. /*<   325 if (irdctc.eq.1) value(locs+1)=1.0d0/value(locs+1) >*/
  719. L325:
  720.     if (irdctc == 1) {
  721.     blank_1.value[locs] = 1. / blank_1.value[locs];
  722.     }
  723. /*<       if (irdct2.eq.1) value(locs2+1)=1.0d0/value(locs2+1) >*/
  724.     if (irdct2 == 1) {
  725.     blank_1.value[locs2] = 1. / blank_1.value[locs2];
  726.     }
  727. /*<       icalc=0 >*/
  728.     status_1.icalc = 0;
  729. /*<       ical2=0 >*/
  730.     ical2 = 0;
  731. /*<       loctim=3 >*/
  732.     loctim = 3;
  733. /*<   340 initf=2 >*/
  734. L340:
  735.     status_1.initf = 2;
  736. /*<       call iter8(itl1) >*/
  737.     iter8_(&flags_1.itl1);
  738. /*<       rstats(4)=rstats(4)+iterno >*/
  739.     miscel_1.rstats[3] += status_1.iterno;
  740. /*<       call copy8(value(lx0+1),value(lx1+1),nxtrm) >*/
  741.     copy8_(&blank_1.value[tabinf_1.lx0], &blank_1.value[tabinf_1.lx1], &
  742.         cirdat_1.nxtrm);
  743. /*<       if(nolx2.eq.0) call copy8(value(lx0+1),value(lx2+1),nxtrm) >*/
  744.     if (nolx2 == 0) {
  745.     copy8_(&blank_1.value[tabinf_1.lx0], &blank_1.value[tabinf_1.lx2], &
  746.         cirdat_1.nxtrm);
  747.     }
  748. /*<       if (igoof.ne.0) go to 450 >*/
  749.     if (flags_1.igoof != 0) {
  750.     goto L450;
  751.     }
  752. /*<       go to 360 >*/
  753.     goto L360;
  754. /*<   350 call getcje >*/
  755. L350:
  756.     getcje_();
  757. /*<       if ((maxtim-itime).le.limtim) go to 460 >*/
  758.     if (cje_1.maxtim - cje_1.itime <= flags_1.limtim) {
  759.     goto L460;
  760.     }
  761. /*<       initf=6 >*/
  762.     status_1.initf = 6;
  763. /*<       call iter8(itl2) >*/
  764.     iter8_(&flags_1.itl2);
  765. /*<       rstats(4)=rstats(4)+iterno >*/
  766.     miscel_1.rstats[3] += status_1.iterno;
  767. /*<       if (igoof.ne.0) go to 340 >*/
  768.     if (flags_1.igoof != 0) {
  769.     goto L340;
  770.     }
  771.  
  772. /*  store outputs */
  773.  
  774. /*<   360 call extmem(loutpt,numout) >*/
  775. L360:
  776.     extmem_(&tabinf_1.loutpt, &numout);
  777. /*<       loco=loutpt+icalc*numout >*/
  778.     loco = tabinf_1.loutpt + status_1.icalc * numout;
  779. /*<       icalc=icalc+1 >*/
  780.     ++status_1.icalc;
  781. /*<       ical2=ical2+1 >*/
  782.     ++ical2;
  783. /*<       value(loco+1)=value(locs+1) >*/
  784.     blank_1.value[loco] = blank_1.value[locs];
  785. /*<       if (irdctc.eq.1) value(loco+1)=1.0d0/value(loco+1) >*/
  786.     if (irdctc == 1) {
  787.     blank_1.value[loco] = 1. / blank_1.value[loco];
  788.     }
  789. /*<       loc=locate(41) >*/
  790.     loc = cirdat_1.locate[40];
  791. /*<   370 if (loc.eq.0) go to 400 >*/
  792. L370:
  793.     if (loc == 0) {
  794.     goto L400;
  795.     }
  796. /*<       if (nodplc(loc+5).ne.0) go to 380 >*/
  797.     if (nodplc[loc + 4] != 0) {
  798.     goto L380;
  799.     }
  800. /*<       node1=nodplc(loc+2) >*/
  801.     node1 = nodplc[loc + 1];
  802. /*<       node2=nodplc(loc+3) >*/
  803.     node2 = nodplc[loc + 2];
  804. /*<       iseq=nodplc(loc+4) >*/
  805.     tabinf_1.iseq = nodplc[loc + 3];
  806. /*<       value(loco+iseq)=value(lvnim1+node1)-value(lvnim1+node2) >*/
  807.     blank_1.value[loco + tabinf_1.iseq - 1] = blank_1.value[tabinf_1.lvnim1 + 
  808.         node1 - 1] - blank_1.value[tabinf_1.lvnim1 + node2 - 1];
  809. /*<       loc=nodplc(loc) >*/
  810.     loc = nodplc[loc - 1];
  811. /*<       go to 370 >*/
  812.     goto L370;
  813. /*<   380 iptr=nodplc(loc+2) >*/
  814. L380:
  815.     iptr = nodplc[loc + 1];
  816. /*<       iptr=nodplc(iptr+6) >*/
  817.     iptr = nodplc[iptr + 5];
  818. /*<       iseq=nodplc(loc+4) >*/
  819.     tabinf_1.iseq = nodplc[loc + 3];
  820. /*<       value(loco+iseq)=value(lvnim1+iptr) >*/
  821.     blank_1.value[loco + tabinf_1.iseq - 1] = blank_1.value[tabinf_1.lvnim1 + 
  822.         iptr - 1];
  823. /*<       loc=nodplc(loc) >*/
  824.     loc = nodplc[loc - 1];
  825. /*<       go to 370 >*/
  826.     goto L370;
  827.  
  828. /*  increment source value */
  829.  
  830. /*<   400 if(ipostp.eq.0) go to 410 >*/
  831. L400:
  832.     if (status_1.ipostp == 0) {
  833.     goto L410;
  834.     }
  835. /*<       value(ibuff+1)=value(locs+1) >*/
  836.     blank_1.value[ibuff] = blank_1.value[locs];
  837. /*<       call copy8(value(lvnim1+2),value(ibuff+2),nunods-1) >*/
  838.     i_1 = cirdat_1.nunods - 1;
  839.     copy8_(&blank_1.value[tabinf_1.lvnim1 + 1], &blank_1.value[ibuff + 1], &
  840.         i_1);
  841. /*<       if(numcur.ne.0) call copy8(value(lvnim1+loccur+1), >*/
  842. /*<      1  value(ibuff+nunods+1),numcur) >*/
  843.     if (numcur != 0) {
  844.     copy8_(&blank_1.value[tabinf_1.lvnim1 + loccur], &blank_1.value[ibuff 
  845.         + cirdat_1.nunods], &numcur);
  846.     }
  847. /*<       call fwrite(value(ibuff+1),numpos) >*/
  848.     fwrite_(&blank_1.value[ibuff], &numpos);
  849. /*<   410 if (icalc.ge.icvflg) go to 490 >*/
  850. L410:
  851.     if (status_1.icalc >= dc_1.icvflg) {
  852.     goto L490;
  853.     }
  854. /*<       if(ical2.ge.icvfl1) go to 480 >*/
  855.     if (ical2 >= icvfl1) {
  856.     goto L480;
  857.     }
  858. /*<       if(nolx2.ne.0) go to 420 >*/
  859.     if (nolx2 != 0) {
  860.     goto L420;
  861.     }
  862. /*<       call ptrmem(lx2,itemp) >*/
  863.     ptrmem_(&tabinf_1.lx2, &itemp);
  864. /*<       call ptrmem(lx1,lx2) >*/
  865.     ptrmem_(&tabinf_1.lx1, &tabinf_1.lx2);
  866. /*<       go to 430 >*/
  867.     goto L430;
  868. /*<   420 call ptrmem(lx1,itemp) >*/
  869. L420:
  870.     ptrmem_(&tabinf_1.lx1, &itemp);
  871. /*<   430 call ptrmem(lx0,lx1) >*/
  872. L430:
  873.     ptrmem_(&tabinf_1.lx0, &tabinf_1.lx1);
  874. /*<       call ptrmem(itemp,lx0) >*/
  875.     ptrmem_(&itemp, &tabinf_1.lx0);
  876. /*<       value(locs+1)=tcstar(1)+dble(ical2)*delta >*/
  877.     blank_1.value[locs] = dc_1.tcstar[0] + (doublereal) ical2 * 
  878.         status_1.delta;
  879. /*<       if (itdctc.ne.1) go to 440 >*/
  880.     if (itdctc != 1) {
  881.     goto L440;
  882.     }
  883. /*<       value(itemps+itemno-1)=value(itemps+itemno) >*/
  884.     blank_1.value[tabinf_1.itemps + status_1.itemno - 2] = blank_1.value[
  885.         tabinf_1.itemps + status_1.itemno - 1];
  886. /*<       value(itemps+itemno)=value(locs+1) >*/
  887.     blank_1.value[tabinf_1.itemps + status_1.itemno - 1] = blank_1.value[locs]
  888.         ;
  889. /*<       call tmpupd >*/
  890.     tmpupd_();
  891. /*<   440 if (irdctc.eq.1) value(locs+1)=1.0d0/value(locs+1) >*/
  892. L440:
  893.     if (irdctc == 1) {
  894.     blank_1.value[locs] = 1. / blank_1.value[locs];
  895.     }
  896. /*<       go to 350 >*/
  897.     goto L350;
  898.  
  899. /*  no convergence */
  900.  
  901. /*<   450 itemp=itcelm(1) >*/
  902. L450:
  903.     itemp = dc_1.itcelm[0];
  904. /*<       loce=nodplc(itemp+1) >*/
  905.     loce = nodplc[itemp];
  906. /*<       write (iofile,451) value(loce),value(locs+1) >*/
  907.     io__52.ciunit = status_1.iofile;
  908.     s_wsfe(&io__52);
  909.     do_fio(&c__1, (char *)&blank_1.value[loce - 1], (ftnlen)sizeof(doublereal)
  910.         );
  911.     do_fio(&c__1, (char *)&blank_1.value[locs], (ftnlen)sizeof(doublereal));
  912.     e_wsfe();
  913. /*<   451 format('1*error*:  no convergence in dc transfer curves at ',a8, >*/
  914. /*<      1   ' = ',1pd10.3/'0last node voltages:'/) >*/
  915. /*<       write (iofile,avhdr) (anode,avltg,i=1,nvprln) >*/
  916.     io__53.ciunit = status_1.iofile;
  917.     s_wsfe(&io__53);
  918.     i_1 = nvprln;
  919.     for (i = 1; i <= i_1; ++i) {
  920.     do_fio(&c__1, (char *)&anode, (ftnlen)sizeof(doublereal));
  921.     do_fio(&c__1, (char *)&avltg, (ftnlen)sizeof(doublereal));
  922.     }
  923.     e_wsfe();
  924. /*<       write (iofile,avfrm) (lprn,nodplc(junode+i),value(lvnim1+i), >*/
  925. /*<      1  i=2,ncnods) >*/
  926.     io__54.ciunit = status_1.iofile;
  927.     s_wsfe(&io__54);
  928.     i_1 = cirdat_1.ncnods;
  929.     for (i = 2; i <= i_1; ++i) {
  930.     do_fio(&c__1, (char *)&lprn, (ftnlen)sizeof(integer));
  931.     do_fio(&c__1, (char *)&nodplc[tabinf_1.junode + i - 1], (ftnlen)
  932.         sizeof(integer));
  933.     do_fio(&c__1, (char *)&blank_1.value[tabinf_1.lvnim1 + i - 1], (
  934.         ftnlen)sizeof(doublereal));
  935.     }
  936.     e_wsfe();
  937. /*<       go to 470 >*/
  938.     goto L470;
  939. /*<   460 write (iofile,461) >*/
  940. L460:
  941.     io__55.ciunit = status_1.iofile;
  942.     s_wsfe(&io__55);
  943.     e_wsfe();
  944. /*<   461 format('0*error*:  cpu time limit exceeded ... analysis stopped'/) >*/
  945. /*<       go to 470 >*/
  946.     goto L470;
  947. /*<   462 write(iofile,463) >*/
  948. L462:
  949.     io__56.ciunit = status_1.iofile;
  950.     s_wsfe(&io__56);
  951.     e_wsfe();
  952. /*<   463 format('0*error*:   temperature sweep should be the second sweep >*/
  953. /*<      1source, change the order and re-execute'/) >*/
  954. /*<   470 nogo=1 >*/
  955. L470:
  956.     flags_1.nogo = 1;
  957. /*<       go to 490 >*/
  958.     goto L490;
  959. /* ... reset first sweep variable ... step second */
  960. /*<   480 ical2=0 >*/
  961. L480:
  962.     ical2 = 0;
  963. /*<       value(locs+1)=tcstar(1) >*/
  964.     blank_1.value[locs] = dc_1.tcstar[0];
  965. /*<       if (irdctc.eq.1) value(locs+1)=1.0d0/value(locs+1) >*/
  966.     if (irdctc == 1) {
  967.     blank_1.value[locs] = 1. / blank_1.value[locs];
  968.     }
  969. /*<       if (itdctc.eq.1) go to 462 >*/
  970.     if (itdctc == 1) {
  971.     goto L462;
  972.     }
  973. /*<       value(locs2+1)=value(locs2+1)+tcincr(2) >*/
  974.     blank_1.value[locs2] += dc_1.tcincr[1];
  975. /*<       if (irdct2.eq.1) value(locs2+1)=1.0d0/value(locs2+1) >*/
  976.     if (irdct2 == 1) {
  977.     blank_1.value[locs2] = 1. / blank_1.value[locs2];
  978.     }
  979. /*<       if (itdct2.ne.1) go to 340 >*/
  980.     if (itdct2 != 1) {
  981.     goto L340;
  982.     }
  983. /*<       value(itemps+itemno-1)=value(itemps+itemno) >*/
  984.     blank_1.value[tabinf_1.itemps + status_1.itemno - 2] = blank_1.value[
  985.         tabinf_1.itemps + status_1.itemno - 1];
  986. /*<       value(itemps+itemno)=value(locs2+1) >*/
  987.     blank_1.value[tabinf_1.itemps + status_1.itemno - 1] = blank_1.value[
  988.         locs2];
  989. /*<       call tmpupd >*/
  990.     tmpupd_();
  991. /*<       go to 340 >*/
  992.     goto L340;
  993.  
  994. /*  finished with dc transfer curves */
  995.  
  996. /*<   490 value(locs+1)=temval >*/
  997. L490:
  998.     blank_1.value[locs] = temval;
  999. /*<       if(itcelm(2).ne.0) value(locs2+1)=temv2 >*/
  1000.     if (dc_1.itcelm[1] != 0) {
  1001.     blank_1.value[locs2] = temv2;
  1002.     }
  1003. /*<       if ((itdctc.eq.0).and.(itdct2.eq.0)) go to 1000 >*/
  1004.     if (itdctc == 0 && itdct2 == 0) {
  1005.     goto L1000;
  1006.     }
  1007. /*<       value(itemps+itemno-1)=value(itemps+itemno) >*/
  1008.     blank_1.value[tabinf_1.itemps + status_1.itemno - 2] = blank_1.value[
  1009.         tabinf_1.itemps + status_1.itemno - 1];
  1010. /*<       if (itdctc.eq.1) value(itemps+itemno)=temval >*/
  1011.     if (itdctc == 1) {
  1012.     blank_1.value[tabinf_1.itemps + status_1.itemno - 1] = temval;
  1013.     }
  1014. /*<       if (itdct2.eq.1) value(itemps+itemno)=temv2 >*/
  1015.     if (itdct2 == 1) {
  1016.     blank_1.value[tabinf_1.itemps + status_1.itemno - 1] = temv2;
  1017.     }
  1018. /*<       write (iofile,492) >*/
  1019.     io__57.ciunit = status_1.iofile;
  1020.     s_wsfe(&io__57);
  1021.     e_wsfe();
  1022. /*<   492 format (/,'0*****0 return to original temperature 0*****0',/) >*/
  1023. /*<       call tmpupd >*/
  1024.     tmpupd_();
  1025. /*<       itemno=1 >*/
  1026.     status_1.itemno = 1;
  1027. /*<       call relmem(itemps,2) >*/
  1028.     relmem_(&tabinf_1.itemps, &c__2);
  1029. /*<       if(ipostp.eq.0) go to 1000 >*/
  1030.     if (status_1.ipostp == 0) {
  1031.     goto L1000;
  1032.     }
  1033. /*<       call fwrite(value(ibuff+1),numpos) >*/
  1034.     fwrite_(&blank_1.value[ibuff], &numpos);
  1035. /*<       go to 1000 >*/
  1036.     goto L1000;
  1037.  
  1038. /*  ....  transient analysis */
  1039.  
  1040. /*<   500 numout=jelcnt(42)+1 >*/
  1041. L500:
  1042.     numout = cirdat_1.jelcnt[41] + 1;
  1043. /*<       if(ipostp.ne.0) call pheadr(atitle) >*/
  1044.     if (status_1.ipostp != 0) {
  1045.     pheadr_(miscel_1.atitle);
  1046.     }
  1047. /* ...  limit delmax if no energy-storage elements */
  1048. /*<       numese=jelcnt(2)+jelcnt(3)+jelcnt(11)+jelcnt(12)+jelcnt(13) >*/
  1049. /*<      1   +jelcnt(14) >*/
  1050.     numese = cirdat_1.jelcnt[1] + cirdat_1.jelcnt[2] + cirdat_1.jelcnt[10] + 
  1051.         cirdat_1.jelcnt[11] + cirdat_1.jelcnt[12] + cirdat_1.jelcnt[13];
  1052. /*<       if (numese.eq.0) delmax=dmin1(delmax,tstep) >*/
  1053.     if (numese == 0) {
  1054.     tran_1.delmax = min(tran_1.delmax,tran_1.tstep);
  1055.     }
  1056. /*<       initf=5 >*/
  1057.     status_1.initf = 5;
  1058. /*<       iord=1 >*/
  1059.     status_1.iord = 1;
  1060. /*<       loctim=9 >*/
  1061.     loctim = 9;
  1062. /*<       icalc=0 >*/
  1063.     status_1.icalc = 0;
  1064. /*<       numtp=0 >*/
  1065.     numtp = 0;
  1066. /*<       numrtp=0 >*/
  1067.     numrtp = 0;
  1068. /*<       numnit=0 >*/
  1069.     numnit = 0;
  1070. /*<       time=0.0d0 >*/
  1071.     status_1.time = 0.;
  1072. /*<       ibkflg=1 >*/
  1073.     ibkflg = 1;
  1074. /*<       delbkp=delmax >*/
  1075.     delbkp = tran_1.delmax;
  1076. /*<       nbkpt=1 >*/
  1077.     nbkpt = 1;
  1078. /*<       delta=delmax >*/
  1079.     status_1.delta = tran_1.delmax;
  1080. /*<       do 510 i=1,7 >*/
  1081.     for (i = 1; i <= 7; ++i) {
  1082. /*<       delold(i)=delta >*/
  1083.     status_1.delold[i - 1] = status_1.delta;
  1084. /*<   510 continue >*/
  1085. /* L510: */
  1086.     }
  1087. /*<       delnew=delta >*/
  1088.     delnew = status_1.delta;
  1089. /*<       delmin=1.0d-9*delmax >*/
  1090.     delmin = tran_1.delmax * 1e-9;
  1091. /*<       go to 650 >*/
  1092.     goto L650;
  1093.  
  1094. /*  increment time, update sources, and solve next timepoint */
  1095.  
  1096. /*<   600 time=time+delta >*/
  1097. L600:
  1098.     status_1.time += status_1.delta;
  1099. /*<       call sorupd >*/
  1100.     sorupd_();
  1101. /*<       if (nogo.ne.0) go to 950 >*/
  1102.     if (flags_1.nogo != 0) {
  1103.     goto L950;
  1104.     }
  1105. /*<       call getcje >*/
  1106.     getcje_();
  1107. /*<       if ((maxtim-itime).le.limtim) go to 920 >*/
  1108.     if (cje_1.maxtim - cje_1.itime <= flags_1.limtim) {
  1109.     goto L920;
  1110.     }
  1111. /*<       if ((itl5.ne.0).and.(numnit.ge.itl5)) go to 905 >*/
  1112.     if (flags_1.itl5 != 0 && numnit >= flags_1.itl5) {
  1113.     goto L905;
  1114.     }
  1115. /*<       call comcof >*/
  1116.     comcof_();
  1117. /*<       if (initf.ne.5) initf=6 >*/
  1118.     if (status_1.initf != 5) {
  1119.     status_1.initf = 6;
  1120.     }
  1121. /*<       itrlim=itl4 >*/
  1122.     itrlim = flags_1.itl4;
  1123. /*<       if ((numtp.eq.0).and.(nosolv.ne.0)) itrlim=itl1 >*/
  1124.     if (numtp == 0 && status_1.nosolv != 0) {
  1125.     itrlim = flags_1.itl1;
  1126.     }
  1127. /*<       call iter8(itrlim) >*/
  1128.     iter8_(&itrlim);
  1129. /*<       numnit=numnit+iterno >*/
  1130.     numnit += status_1.iterno;
  1131. /*<       numtp=numtp+1 >*/
  1132.     ++numtp;
  1133. /*<       if (numtp.ne.1) go to 605 >*/
  1134.     if (numtp != 1) {
  1135.     goto L605;
  1136.     }
  1137. /*<       if(nolx2.eq.0) call copy8(value(lx1+1),value(lx2+1),nxtrm) >*/
  1138.     if (nolx2 == 0) {
  1139.     copy8_(&blank_1.value[tabinf_1.lx1], &blank_1.value[tabinf_1.lx2], &
  1140.         cirdat_1.nxtrm);
  1141.     }
  1142. /*<       if(nolx3.eq.0) call copy8(value(lx1+1),value(lx3+1),nxtrm) >*/
  1143.     if (nolx3 == 0) {
  1144.     copy8_(&blank_1.value[tabinf_1.lx1], &blank_1.value[tabinf_1.lx3], &
  1145.         cirdat_1.nxtrm);
  1146.     }
  1147. /* .. note that time-point is cut when itrlim exceeded regardless */
  1148. /* .. of which time-step contol is specified thru 'lvltim'. */
  1149. /*<   605 if (igoof.eq.0) go to 610 >*/
  1150. L605:
  1151.     if (flags_1.igoof == 0) {
  1152.     goto L610;
  1153.     }
  1154. /*<       jord=iord >*/
  1155.     jord = status_1.iord;
  1156. /*<       iord=1 >*/
  1157.     status_1.iord = 1;
  1158. /*<       if (jord.ge.5) call clrmem(lx7) >*/
  1159.     if (jord >= 5) {
  1160.     clrmem_(&tabinf_1.lx7);
  1161.     }
  1162. /*<       if (jord.ge.4) call clrmem(lx6) >*/
  1163.     if (jord >= 4) {
  1164.     clrmem_(&tabinf_1.lx6);
  1165.     }
  1166. /*<       if (jord.ge.3) call clrmem(lx5) >*/
  1167.     if (jord >= 3) {
  1168.     clrmem_(&tabinf_1.lx5);
  1169.     }
  1170. /*<       if ((jord.ge.2).and.(method.ne.1)) call clrmem(lx4) >*/
  1171.     if (jord >= 2 && status_1.method != 1) {
  1172.     clrmem_(&tabinf_1.lx4);
  1173.     }
  1174. /*<       igoof=0 >*/
  1175.     flags_1.igoof = 0;
  1176. /*<       time=time-delta >*/
  1177.     status_1.time -= status_1.delta;
  1178. /*<       delta=delta/8.0d0 >*/
  1179.     status_1.delta /= 8.;
  1180. /*<       go to 620 >*/
  1181.     goto L620;
  1182. /*<   610 delnew=delta >*/
  1183. L610:
  1184.     delnew = status_1.delta;
  1185. /*<       if (numtp.eq.1) go to 630 >*/
  1186.     if (numtp == 1) {
  1187.     goto L630;
  1188.     }
  1189. /*<       call trunc(delnew) >*/
  1190.     trunc_(&delnew);
  1191. /*<       if (delnew.ge.(0.9d0*delta)) go to 630 >*/
  1192.     if (delnew >= status_1.delta * .9) {
  1193.     goto L630;
  1194.     }
  1195. /*<       time=time-delta >*/
  1196.     status_1.time -= status_1.delta;
  1197. /*<       delta=delnew >*/
  1198.     status_1.delta = delnew;
  1199. /*<   620 numrtp=numrtp+1 >*/
  1200. L620:
  1201.     ++numrtp;
  1202. /*<       ibkflg=0 >*/
  1203.     ibkflg = 0;
  1204. /*<       delold(1)=delta >*/
  1205.     status_1.delold[0] = status_1.delta;
  1206. /*<       if (delta.ge.delmin) go to 600 >*/
  1207.     if (status_1.delta >= delmin) {
  1208.     goto L600;
  1209.     }
  1210. /*<       time=time+delta >*/
  1211.     status_1.time += status_1.delta;
  1212. /*<       go to 900 >*/
  1213.     goto L900;
  1214.  
  1215. /*  determine order of integration method */
  1216.  
  1217. /* ...  skip if trapezoidal algorithm used */
  1218. /*<   630 if ((method.eq.1).and.(iord.eq.2)) go to 650 >*/
  1219. L630:
  1220.     if (status_1.method == 1 && status_1.iord == 2) {
  1221.     goto L650;
  1222.     }
  1223. /*<       if (numtp.eq.1) go to 650 >*/
  1224.     if (numtp == 1) {
  1225.     goto L650;
  1226.     }
  1227. /*<       ordrat=1.05d0 >*/
  1228.     ordrat = 1.05;
  1229. /*<       if (iord.gt.1) go to 635 >*/
  1230.     if (status_1.iord > 1) {
  1231.     goto L635;
  1232.     }
  1233. /*<       iord=2 >*/
  1234.     status_1.iord = 2;
  1235. /*<       call trunc(delnew) >*/
  1236.     trunc_(&delnew);
  1237. /*<       iord=1 >*/
  1238.     status_1.iord = 1;
  1239. /*<       if ((delnew/delta).le.ordrat) go to 650 >*/
  1240.     if (delnew / status_1.delta <= ordrat) {
  1241.     goto L650;
  1242.     }
  1243. /*<       if (maxord.le.1) go to 650 >*/
  1244.     if (status_1.maxord <= 1) {
  1245.     goto L650;
  1246.     }
  1247. /*<       iord=2 >*/
  1248.     status_1.iord = 2;
  1249. /*<       if (method.eq.1) go to 650 >*/
  1250.     if (status_1.method == 1) {
  1251.     goto L650;
  1252.     }
  1253. /*<       call getm8(lx4,nxtrm) >*/
  1254.     getm8_(&tabinf_1.lx4, &cirdat_1.nxtrm);
  1255. /*<       go to 650 >*/
  1256.     goto L650;
  1257. /*<   635 if (iord.lt.maxord) go to 640 >*/
  1258. L635:
  1259.     if (status_1.iord < status_1.maxord) {
  1260.     goto L640;
  1261.     }
  1262. /*<       iord=iord-1 >*/
  1263.     --status_1.iord;
  1264. /*<       call trunc(delnew) >*/
  1265.     trunc_(&delnew);
  1266. /*<       iord=iord+1 >*/
  1267.     ++status_1.iord;
  1268. /*<       if ((delnew/delta).le.ordrat) go to 650 >*/
  1269.     if (delnew / status_1.delta <= ordrat) {
  1270.     goto L650;
  1271.     }
  1272. /*<       go to 642 >*/
  1273.     goto L642;
  1274. /*<   640 iord=iord-1 >*/
  1275. L640:
  1276.     --status_1.iord;
  1277. /*<       call trunc(delnew) >*/
  1278.     trunc_(&delnew);
  1279. /*<       iord=iord+1 >*/
  1280.     ++status_1.iord;
  1281. /*<       if ((delnew/delta).le.ordrat) go to 645 >*/
  1282.     if (delnew / status_1.delta <= ordrat) {
  1283.     goto L645;
  1284.     }
  1285. /*<   642 iord=iord-1 >*/
  1286. L642:
  1287.     --status_1.iord;
  1288. /*<       if (iord.eq.1) call clrmem(lx4) >*/
  1289.     if (status_1.iord == 1) {
  1290.     clrmem_(&tabinf_1.lx4);
  1291.     }
  1292. /*<       if (iord.eq.2) call clrmem(lx5) >*/
  1293.     if (status_1.iord == 2) {
  1294.     clrmem_(&tabinf_1.lx5);
  1295.     }
  1296. /*<       if (iord.eq.3) call clrmem(lx6) >*/
  1297.     if (status_1.iord == 3) {
  1298.     clrmem_(&tabinf_1.lx6);
  1299.     }
  1300. /*<       if (iord.eq.4) call clrmem(lx7) >*/
  1301.     if (status_1.iord == 4) {
  1302.     clrmem_(&tabinf_1.lx7);
  1303.     }
  1304. /*<       go to 650 >*/
  1305.     goto L650;
  1306. /*<   645 iord=iord+1 >*/
  1307. L645:
  1308.     ++status_1.iord;
  1309. /*<       call trunc(delnew) >*/
  1310.     trunc_(&delnew);
  1311. /*<       iord=iord-1 >*/
  1312.     --status_1.iord;
  1313. /*<       if ((delnew/delta).le.ordrat) go to 650 >*/
  1314.     if (delnew / status_1.delta <= ordrat) {
  1315.     goto L650;
  1316.     }
  1317. /*<       iord=iord+1 >*/
  1318.     ++status_1.iord;
  1319. /*<       if (iord.eq.2) call getm8(lx4,nxtrm) >*/
  1320.     if (status_1.iord == 2) {
  1321.     getm8_(&tabinf_1.lx4, &cirdat_1.nxtrm);
  1322.     }
  1323. /*<       if (iord.eq.3) call getm8(lx5,nxtrm) >*/
  1324.     if (status_1.iord == 3) {
  1325.     getm8_(&tabinf_1.lx5, &cirdat_1.nxtrm);
  1326.     }
  1327. /*<       if (iord.eq.4) call getm8(lx6,nxtrm) >*/
  1328.     if (status_1.iord == 4) {
  1329.     getm8_(&tabinf_1.lx6, &cirdat_1.nxtrm);
  1330.     }
  1331. /*<       if (iord.eq.5) call getm8(lx7,nxtrm) >*/
  1332.     if (status_1.iord == 5) {
  1333.     getm8_(&tabinf_1.lx7, &cirdat_1.nxtrm);
  1334.     }
  1335.  
  1336. /*  store outputs */
  1337.  
  1338. /*<   650 if ((time+delta).le.tstart) go to 685 >*/
  1339. L650:
  1340.     if (status_1.time + status_1.delta <= tran_1.tstart) {
  1341.     goto L685;
  1342.     }
  1343. /*<       if ((numtp.eq.0).and.(nosolv.ne.0)) go to 685 >*/
  1344.     if (numtp == 0 && status_1.nosolv != 0) {
  1345.     goto L685;
  1346.     }
  1347. /*<       call extmem(loutpt,numout) >*/
  1348.     extmem_(&tabinf_1.loutpt, &numout);
  1349. /*<       loco=loutpt+icalc*numout >*/
  1350.     loco = tabinf_1.loutpt + status_1.icalc * numout;
  1351. /*<       icalc=icalc+1 >*/
  1352.     ++status_1.icalc;
  1353. /*<       value(loco+1)=time >*/
  1354.     blank_1.value[loco] = status_1.time;
  1355. /*<       loc=locate(42) >*/
  1356.     loc = cirdat_1.locate[41];
  1357. /*<   670 if (loc.eq.0) go to 682 >*/
  1358. L670:
  1359.     if (loc == 0) {
  1360.     goto L682;
  1361.     }
  1362. /*<       if (nodplc(loc+5).ne.0) go to 680 >*/
  1363.     if (nodplc[loc + 4] != 0) {
  1364.     goto L680;
  1365.     }
  1366. /*<       node1=nodplc(loc+2) >*/
  1367.     node1 = nodplc[loc + 1];
  1368. /*<       node2=nodplc(loc+3) >*/
  1369.     node2 = nodplc[loc + 2];
  1370. /*<       iseq=nodplc(loc+4) >*/
  1371.     tabinf_1.iseq = nodplc[loc + 3];
  1372. /*<       value(loco+iseq)=value(lvnim1+node1)-value(lvnim1+node2) >*/
  1373.     blank_1.value[loco + tabinf_1.iseq - 1] = blank_1.value[tabinf_1.lvnim1 + 
  1374.         node1 - 1] - blank_1.value[tabinf_1.lvnim1 + node2 - 1];
  1375. /*<       loc=nodplc(loc) >*/
  1376.     loc = nodplc[loc - 1];
  1377. /*<       go to 670 >*/
  1378.     goto L670;
  1379. /*<   680 iptr=nodplc(loc+2) >*/
  1380. L680:
  1381.     iptr = nodplc[loc + 1];
  1382. /*<       iptr=nodplc(iptr+6) >*/
  1383.     iptr = nodplc[iptr + 5];
  1384. /*<       iseq=nodplc(loc+4) >*/
  1385.     tabinf_1.iseq = nodplc[loc + 3];
  1386. /*<       value(loco+iseq)=value(lvnim1+iptr) >*/
  1387.     blank_1.value[loco + tabinf_1.iseq - 1] = blank_1.value[tabinf_1.lvnim1 + 
  1388.         iptr - 1];
  1389. /*<       loc=nodplc(loc) >*/
  1390.     loc = nodplc[loc - 1];
  1391. /*<       go to 670 >*/
  1392.     goto L670;
  1393. /*<   682 if(ipostp.eq.0) go to 684 >*/
  1394. L682:
  1395.     if (status_1.ipostp == 0) {
  1396.     goto L684;
  1397.     }
  1398. /*<       value(ibuff+1)=time >*/
  1399.     blank_1.value[ibuff] = status_1.time;
  1400. /*<       call copy8(value(lvnim1+2),value(ibuff+2),nunods-1) >*/
  1401.     i_1 = cirdat_1.nunods - 1;
  1402.     copy8_(&blank_1.value[tabinf_1.lvnim1 + 1], &blank_1.value[ibuff + 1], &
  1403.         i_1);
  1404. /*<       if(numcur.ne.0) call copy8(value(lvnim1+loccur+1), >*/
  1405. /*<      1  value(ibuff+nunods+1),numcur) >*/
  1406.     if (numcur != 0) {
  1407.     copy8_(&blank_1.value[tabinf_1.lvnim1 + loccur], &blank_1.value[ibuff 
  1408.         + cirdat_1.nunods], &numcur);
  1409.     }
  1410. /*<       call fwrite(value(ibuff+1),numpos) >*/
  1411.     fwrite_(&blank_1.value[ibuff], &numpos);
  1412. /*<   684 continue >*/
  1413. L684:
  1414.  
  1415. /*  update transmission line delay table */
  1416.  
  1417. /*<   685 if (jelcnt(17).eq.0) go to 694 >*/
  1418. L685:
  1419.     if (cirdat_1.jelcnt[16] == 0) {
  1420.     goto L694;
  1421.     }
  1422. /*<       call sizmem(ltd,ltdsiz) >*/
  1423.     sizmem_(&tabinf_1.ltd, <dsiz);
  1424. /*<       numtd=ltdsiz/ntlin >*/
  1425.     numtd = ltdsiz / cirdat_1.ntlin;
  1426. /*<       if (numtd.le.3) go to 689 >*/
  1427.     if (numtd <= 3) {
  1428.     goto L689;
  1429.     }
  1430. /*<       baktim=time-tdmax >*/
  1431.     baktim = status_1.time - tran_1.tdmax;
  1432. /*<       if (baktim.lt.0.0d0) go to 689 >*/
  1433.     if (baktim < 0.) {
  1434.     goto L689;
  1435.     }
  1436. /*<       lcntr=0 >*/
  1437.     lcntr = 0;
  1438. /*<       ltemp=ltd >*/
  1439.     ltemp = tabinf_1.ltd;
  1440. /*<       do 686 i=1,numtd >*/
  1441.     i_1 = numtd;
  1442.     for (i = 1; i <= i_1; ++i) {
  1443. /*<       if (value(ltemp+1).ge.baktim) go to 687 >*/
  1444.     if (blank_1.value[ltemp] >= baktim) {
  1445.         goto L687;
  1446.     }
  1447. /*<       ltemp=ltemp+ntlin >*/
  1448.     ltemp += cirdat_1.ntlin;
  1449. /*<       lcntr=lcntr+1 >*/
  1450.     ++lcntr;
  1451. /*<   686 continue >*/
  1452. /* L686: */
  1453.     }
  1454. /*<       go to 689 >*/
  1455.     goto L689;
  1456. /*<   687 if (lcntr.le.2) go to 689 >*/
  1457. L687:
  1458.     if (lcntr <= 2) {
  1459.     goto L689;
  1460.     }
  1461. /*<       lcntr=lcntr-2 >*/
  1462.     lcntr += -2;
  1463. /*<       nwords=lcntr*ntlin >*/
  1464.     nwords = lcntr * cirdat_1.ntlin;
  1465. /*<       ltemp=ltemp-ntlin-ntlin >*/
  1466.     ltemp = ltemp - cirdat_1.ntlin - cirdat_1.ntlin;
  1467. /*<       call copy8(value(ltemp+1),value(ltd+1),ltdsiz-nwords) >*/
  1468.     i_1 = ltdsiz - nwords;
  1469.     copy8_(&blank_1.value[ltemp], &blank_1.value[tabinf_1.ltd], &i_1);
  1470. /*<       call relmem(ltd,nwords) >*/
  1471.     relmem_(&tabinf_1.ltd, &nwords);
  1472. /*<       call sizmem(ltd,ltdsiz) >*/
  1473.     sizmem_(&tabinf_1.ltd, <dsiz);
  1474. /*<   689 call extmem(ltd,ntlin) >*/
  1475. L689:
  1476.     extmem_(&tabinf_1.ltd, &cirdat_1.ntlin);
  1477. /*<       ltdptr=ltd+ltdsiz >*/
  1478.     ltdptr = tabinf_1.ltd + ltdsiz;
  1479. /*<       value(ltdptr+1)=time >*/
  1480.     blank_1.value[ltdptr] = status_1.time;
  1481. /*<       loc=locate(17) >*/
  1482.     loc = cirdat_1.locate[16];
  1483. /*<   690 if (loc.eq.0) go to 693 >*/
  1484. L690:
  1485.     if (loc == 0) {
  1486.     goto L693;
  1487.     }
  1488. /*<       locv=nodplc(loc+1) >*/
  1489.     locv = nodplc[loc];
  1490. /*<       z0=value(locv+1) >*/
  1491.     z0 = blank_1.value[locv];
  1492. /*<       node1=nodplc(loc+2) >*/
  1493.     node1 = nodplc[loc + 1];
  1494. /*<       node2=nodplc(loc+3) >*/
  1495.     node2 = nodplc[loc + 2];
  1496. /*<       node3=nodplc(loc+4) >*/
  1497.     node3 = nodplc[loc + 3];
  1498. /*<       node4=nodplc(loc+5) >*/
  1499.     node4 = nodplc[loc + 4];
  1500. /*<       ibr1=nodplc(loc+8) >*/
  1501.     ibr1 = nodplc[loc + 7];
  1502. /*<       ibr2=nodplc(loc+9) >*/
  1503.     ibr2 = nodplc[loc + 8];
  1504. /*<       lspot=nodplc(loc+30)+ltdptr >*/
  1505.     lspot = nodplc[loc + 29] + ltdptr;
  1506. /*<       if ((initf.eq.5).and.(nosolv.ne.0)) go to 691 >*/
  1507.     if (status_1.initf == 5 && status_1.nosolv != 0) {
  1508.     goto L691;
  1509.     }
  1510. /*<       value(lspot)=value(lvnim1+node3)-value(lvnim1+node4) >*/
  1511. /*<      1   +value(lvnim1+ibr2)*z0 >*/
  1512.     blank_1.value[lspot - 1] = blank_1.value[tabinf_1.lvnim1 + node3 - 1] - 
  1513.         blank_1.value[tabinf_1.lvnim1 + node4 - 1] + blank_1.value[
  1514.         tabinf_1.lvnim1 + ibr2 - 1] * z0;
  1515. /*<       value(lspot+1)=value(lvnim1+node1)-value(lvnim1+node2) >*/
  1516. /*<      1   +value(lvnim1+ibr1)*z0 >*/
  1517.     blank_1.value[lspot] = blank_1.value[tabinf_1.lvnim1 + node1 - 1] - 
  1518.         blank_1.value[tabinf_1.lvnim1 + node2 - 1] + blank_1.value[
  1519.         tabinf_1.lvnim1 + ibr1 - 1] * z0;
  1520. /*<       go to 692 >*/
  1521.     goto L692;
  1522. /*<   691 value(lspot)=value(locv+7)+value(locv+8)*z0 >*/
  1523. L691:
  1524.     blank_1.value[lspot - 1] = blank_1.value[locv + 6] + blank_1.value[locv + 
  1525.         7] * z0;
  1526. /*<       value(lspot+1)=value(locv+5)+value(locv+6)*z0 >*/
  1527.     blank_1.value[lspot] = blank_1.value[locv + 4] + blank_1.value[locv + 5] *
  1528.          z0;
  1529. /*<   692 loc=nodplc(loc) >*/
  1530. L692:
  1531.     loc = nodplc[loc - 1];
  1532. /*<       go to 690 >*/
  1533.     goto L690;
  1534.  
  1535. /*  add two *fake* backpoints to ltd for interpolation near time=0.0d0 */
  1536.  
  1537. /*<   693 if (numtd.ne.0) go to 694 >*/
  1538. L693:
  1539.     if (numtd != 0) {
  1540.     goto L694;
  1541.     }
  1542. /*<       call extmem(ltd,ntlin+ntlin) >*/
  1543.     i_1 = cirdat_1.ntlin + cirdat_1.ntlin;
  1544.     extmem_(&tabinf_1.ltd, &i_1);
  1545. /*<       call copy8(value(ltd+1),value(ltd+ntlin+1),ntlin) >*/
  1546.     copy8_(&blank_1.value[tabinf_1.ltd], &blank_1.value[tabinf_1.ltd + 
  1547.         cirdat_1.ntlin], &cirdat_1.ntlin);
  1548. /*<       call copy8(value(ltd+1),value(ltd+2*ntlin+1),ntlin) >*/
  1549.     copy8_(&blank_1.value[tabinf_1.ltd], &blank_1.value[tabinf_1.ltd + (
  1550.         cirdat_1.ntlin << 1)], &cirdat_1.ntlin);
  1551. /*<       value(ltd+2*ntlin+1)=time >*/
  1552.     blank_1.value[tabinf_1.ltd + (cirdat_1.ntlin << 1)] = status_1.time;
  1553. /*<       value(ltd+ntlin+1)=time-delta >*/
  1554.     blank_1.value[tabinf_1.ltd + cirdat_1.ntlin] = status_1.time - 
  1555.         status_1.delta;
  1556. /*<       value(ltd+1)=time-delta-delta >*/
  1557.     blank_1.value[tabinf_1.ltd] = status_1.time - status_1.delta - 
  1558.         status_1.delta;
  1559.  
  1560. /*  rotate state vector storage */
  1561.  
  1562. /* .. time-point accepted */
  1563. /*<   694 call copy8(delold(1),delold(2),6) >*/
  1564. L694:
  1565.     copy8_(status_1.delold, &status_1.delold[1], &c__6);
  1566. /*<       delta=delnew >*/
  1567.     status_1.delta = delnew;
  1568. /*<       delold(1)=delta >*/
  1569.     status_1.delold[0] = status_1.delta;
  1570. /*<       go to (710,706,702,698,696,696), iord >*/
  1571.     switch (status_1.iord) {
  1572.     case 1:  goto L710;
  1573.     case 2:  goto L706;
  1574.     case 3:  goto L702;
  1575.     case 4:  goto L698;
  1576.     case 5:  goto L696;
  1577.     case 6:  goto L696;
  1578.     }
  1579. /*<   696 call ptrmem(lx7,itemp) >*/
  1580. L696:
  1581.     ptrmem_(&tabinf_1.lx7, &itemp);
  1582. /*<       call ptrmem(lx6,lx7) >*/
  1583.     ptrmem_(&tabinf_1.lx6, &tabinf_1.lx7);
  1584. /*<       go to 700 >*/
  1585.     goto L700;
  1586. /*<   698 call ptrmem(lx6,itemp) >*/
  1587. L698:
  1588.     ptrmem_(&tabinf_1.lx6, &itemp);
  1589. /*<   700 call ptrmem(lx5,lx6) >*/
  1590. L700:
  1591.     ptrmem_(&tabinf_1.lx5, &tabinf_1.lx6);
  1592. /*<       go to 704 >*/
  1593.     goto L704;
  1594. /*<   702 call ptrmem(lx5,itemp) >*/
  1595. L702:
  1596.     ptrmem_(&tabinf_1.lx5, &itemp);
  1597. /*<   704 call ptrmem(lx4,lx5) >*/
  1598. L704:
  1599.     ptrmem_(&tabinf_1.lx4, &tabinf_1.lx5);
  1600. /*<       go to 708 >*/
  1601.     goto L708;
  1602. /*<   706 if (method.eq.1) go to 710 >*/
  1603. L706:
  1604.     if (status_1.method == 1) {
  1605.     goto L710;
  1606.     }
  1607. /*<       call ptrmem(lx4,itemp) >*/
  1608.     ptrmem_(&tabinf_1.lx4, &itemp);
  1609. /*<   708 call ptrmem(lx3,lx4) >*/
  1610. L708:
  1611.     ptrmem_(&tabinf_1.lx3, &tabinf_1.lx4);
  1612. /*<       go to 713 >*/
  1613.     goto L713;
  1614. /*<   710 if(nolx3.eq.0) go to 712 >*/
  1615. L710:
  1616.     if (nolx3 == 0) {
  1617.     goto L712;
  1618.     }
  1619. /*<       if(nolx2.eq.0) go to 711 >*/
  1620.     if (nolx2 == 0) {
  1621.     goto L711;
  1622.     }
  1623. /*<       call ptrmem(lx1,itemp) >*/
  1624.     ptrmem_(&tabinf_1.lx1, &itemp);
  1625. /*<       go to 714 >*/
  1626.     goto L714;
  1627. /*<   711 call ptrmem(lx2,itemp) >*/
  1628. L711:
  1629.     ptrmem_(&tabinf_1.lx2, &itemp);
  1630. /*<       call ptrmem(lx1,lx2) >*/
  1631.     ptrmem_(&tabinf_1.lx1, &tabinf_1.lx2);
  1632. /*<       go to 714 >*/
  1633.     goto L714;
  1634. /*<   712 call ptrmem(lx3,itemp) >*/
  1635. L712:
  1636.     ptrmem_(&tabinf_1.lx3, &itemp);
  1637. /*<   713 call ptrmem(lx2,lx3) >*/
  1638. L713:
  1639.     ptrmem_(&tabinf_1.lx2, &tabinf_1.lx3);
  1640. /*<       call ptrmem(lx1,lx2) >*/
  1641.     ptrmem_(&tabinf_1.lx1, &tabinf_1.lx2);
  1642. /*<   714 call ptrmem(lx0,lx1) >*/
  1643. L714:
  1644.     ptrmem_(&tabinf_1.lx0, &tabinf_1.lx1);
  1645. /*<       call ptrmem(itemp,lx0) >*/
  1646.     ptrmem_(&itemp, &tabinf_1.lx0);
  1647.  
  1648. /*  check breakpoints */
  1649.  
  1650. /*<   750 if (ibkflg.eq.0) go to 760 >*/
  1651. /* L750: */
  1652.     if (ibkflg == 0) {
  1653.     goto L760;
  1654.     }
  1655. /* .. just accepted analysis at breakpoint */
  1656. /*<       jord=iord >*/
  1657.     jord = status_1.iord;
  1658. /*<       iord=1 >*/
  1659.     status_1.iord = 1;
  1660. /*<       if (jord.ge.5) call clrmem(lx7) >*/
  1661.     if (jord >= 5) {
  1662.     clrmem_(&tabinf_1.lx7);
  1663.     }
  1664. /*<       if (jord.ge.4) call clrmem(lx6) >*/
  1665.     if (jord >= 4) {
  1666.     clrmem_(&tabinf_1.lx6);
  1667.     }
  1668. /*<       if (jord.ge.3) call clrmem(lx5) >*/
  1669.     if (jord >= 3) {
  1670.     clrmem_(&tabinf_1.lx5);
  1671.     }
  1672. /*<       if ((jord.ge.2).and.(method.ne.1)) call clrmem(lx4) >*/
  1673.     if (jord >= 2 && status_1.method != 1) {
  1674.     clrmem_(&tabinf_1.lx4);
  1675.     }
  1676. /*<       ibkflg=0 >*/
  1677.     ibkflg = 0;
  1678. /*<       nbkpt=nbkpt+1 >*/
  1679.     ++nbkpt;
  1680. /*<       if (nbkpt.gt.numbkp) go to 950 >*/
  1681.     if (nbkpt > tabinf_1.numbkp) {
  1682.     goto L950;
  1683.     }
  1684. /*<       temp=dmin1(delbkp,value(lsbkpt+nbkpt)-time) >*/
  1685. /* Computing MAX */
  1686.     d_1 = delbkp, d_2 = blank_1.value[tabinf_1.lsbkpt + nbkpt - 1] - 
  1687.         status_1.time;
  1688.     temp = min(d_2,d_1);
  1689. /*<       delta=dmin1(delta,0.1d0*temp,delmax) >*/
  1690. /* Computing MAX */
  1691.     d_1 = status_1.delta, d_2 = temp * .1, d_1 = min(d_2,d_1);
  1692.     status_1.delta = min(tran_1.delmax,d_1);
  1693. /*<       if (numtp.eq.0) delta=delta/10.0d0 >*/
  1694.     if (numtp == 0) {
  1695.     status_1.delta /= 10.;
  1696.     }
  1697. /*<       delold(1)=delta >*/
  1698.     status_1.delold[0] = status_1.delta;
  1699. /*<       go to 600 >*/
  1700.     goto L600;
  1701. /*<   760 del1=value(lsbkpt+nbkpt)-time >*/
  1702. L760:
  1703.     del1 = blank_1.value[tabinf_1.lsbkpt + nbkpt - 1] - status_1.time;
  1704. /*<       if ((1.01d0*delta).le.del1) go to 600 >*/
  1705.     if (status_1.delta * 1.01 <= del1) {
  1706.     goto L600;
  1707.     }
  1708. /*<       ibkflg=1 >*/
  1709.     ibkflg = 1;
  1710. /*<       delbkp=delta >*/
  1711.     delbkp = status_1.delta;
  1712. /*<       delta=del1 >*/
  1713.     status_1.delta = del1;
  1714. /*<       delold(1)=delta >*/
  1715.     status_1.delold[0] = status_1.delta;
  1716. /*<       go to 600 >*/
  1717.     goto L600;
  1718.  
  1719. /*  transient analysis failed */
  1720.  
  1721. /*<   900 write (iofile,901) >*/
  1722. L900:
  1723.     io__85.ciunit = status_1.iofile;
  1724.     s_wsfe(&io__85);
  1725.     e_wsfe();
  1726. /*<   901 format('1*error*:  internal timestep too small in transient analys >*/
  1727. /*<      1is'/) >*/
  1728. /*<       go to 910 >*/
  1729.     goto L910;
  1730. /*<   905 write (iofile,906) itl5 >*/
  1731. L905:
  1732.     io__86.ciunit = status_1.iofile;
  1733.     s_wsfe(&io__86);
  1734.     do_fio(&c__1, (char *)&flags_1.itl5, (ftnlen)sizeof(integer));
  1735.     e_wsfe();
  1736. /*<   906 format('1*error*:  transient analysis iterations exceed limit of ' >*/
  1737. /*<      1,i5,/'0this limit may be overridden using the itl5 parameter on th >*/
  1738. /*<      2e .option card') >*/
  1739. /*<   910 write (iofile,911) time,delta,numnit >*/
  1740. L910:
  1741.     io__87.ciunit = status_1.iofile;
  1742.     s_wsfe(&io__87);
  1743.     do_fio(&c__1, (char *)&status_1.time, (ftnlen)sizeof(doublereal));
  1744.     do_fio(&c__1, (char *)&status_1.delta, (ftnlen)sizeof(doublereal));
  1745.     do_fio(&c__1, (char *)&numnit, (ftnlen)sizeof(integer));
  1746.     e_wsfe();
  1747. /*<   911 format(1h0,10x,'time = ',1pd12.5,';  delta = ',d12.5,';  numnit = >*/
  1748. /*<      1',i6/) >*/
  1749. /*<       write (iofile,916) >*/
  1750.     io__88.ciunit = status_1.iofile;
  1751.     s_wsfe(&io__88);
  1752.     e_wsfe();
  1753. /*<   916 format(1h0/'0last node voltages:'/) >*/
  1754. /*<       write (iofile,avhdr) (anode,avltg,i=1,nvprln) >*/
  1755.     io__89.ciunit = status_1.iofile;
  1756.     s_wsfe(&io__89);
  1757.     i_1 = nvprln;
  1758.     for (i = 1; i <= i_1; ++i) {
  1759.     do_fio(&c__1, (char *)&anode, (ftnlen)sizeof(doublereal));
  1760.     do_fio(&c__1, (char *)&avltg, (ftnlen)sizeof(doublereal));
  1761.     }
  1762.     e_wsfe();
  1763. /*<       write (iofile,avfrm) (lprn,nodplc(junode+i),value(lvnim1+i), >*/
  1764. /*<      1  i=2,ncnods) >*/
  1765.     io__90.ciunit = status_1.iofile;
  1766.     s_wsfe(&io__90);
  1767.     i_1 = cirdat_1.ncnods;
  1768.     for (i = 2; i <= i_1; ++i) {
  1769.     do_fio(&c__1, (char *)&lprn, (ftnlen)sizeof(integer));
  1770.     do_fio(&c__1, (char *)&nodplc[tabinf_1.junode + i - 1], (ftnlen)
  1771.         sizeof(integer));
  1772.     do_fio(&c__1, (char *)&blank_1.value[tabinf_1.lvnim1 + i - 1], (
  1773.         ftnlen)sizeof(doublereal));
  1774.     }
  1775.     e_wsfe();
  1776. /*<       go to 930 >*/
  1777.     goto L930;
  1778. /*<   920 write (iofile,921) time >*/
  1779. L920:
  1780.     io__91.ciunit = status_1.iofile;
  1781.     s_wsfe(&io__91);
  1782.     do_fio(&c__1, (char *)&status_1.time, (ftnlen)sizeof(doublereal));
  1783.     e_wsfe();
  1784. /*<   921 format('0*error*:  cpu time limit exceeded in transient analysis ' >*/
  1785. /*<      1   ,'at time = ',1pd13.6/) >*/
  1786. /*<   930 nogo=1 >*/
  1787. L930:
  1788.     flags_1.nogo = 1;
  1789.  
  1790. /*  finished with transient analysis */
  1791.  
  1792. /*<   950 rstats(10)=rstats(10)+numnit >*/
  1793. L950:
  1794.     miscel_1.rstats[9] += numnit;
  1795. /*<       rstats(30)=rstats(30)+numtp >*/
  1796.     miscel_1.rstats[29] += numtp;
  1797. /*<       rstats(31)=rstats(31)+numrtp >*/
  1798.     miscel_1.rstats[30] += numrtp;
  1799. /*<       rstats(32)=rstats(32)+numnit >*/
  1800.     miscel_1.rstats[31] += numnit;
  1801. /*<       if(ipostp.eq.0) go to 1000 >*/
  1802.     if (status_1.ipostp == 0) {
  1803.     goto L1000;
  1804.     }
  1805. /*<       if (ipostp.ne.0) call clsraw >*/
  1806.     if (status_1.ipostp != 0) {
  1807.     clsraw_();
  1808.     }
  1809.  
  1810. /*  return unneeded memory */
  1811.  
  1812. /*<  1000 if (mode.eq.2) go to 1010 >*/
  1813. L1000:
  1814.     if (status_1.mode == 2) {
  1815.     goto L1010;
  1816.     }
  1817. /*<       if (modedc.ne.3) go to 1100 >*/
  1818.     if (status_1.modedc != 3) {
  1819.     goto L1100;
  1820.     }
  1821. /*<  1010 call clrmem(lvnim1) >*/
  1822. L1010:
  1823.     clrmem_(&tabinf_1.lvnim1);
  1824. /*<       call clrmem(lx0) >*/
  1825.     clrmem_(&tabinf_1.lx0);
  1826. /*<       call clrmem(lvn) >*/
  1827.     clrmem_(&tabinf_1.lvn);
  1828. /*<       call clrmem(lx1) >*/
  1829.     clrmem_(&tabinf_1.lx1);
  1830. /*<       if (memptr(macins)) call clrmem(macins) >*/
  1831.     if (memptr_(&tabinf_1.macins)) {
  1832.     clrmem_(&tabinf_1.macins);
  1833.     }
  1834. /*<       if(nolx2.eq.0) call clrmem(lx2) >*/
  1835.     if (nolx2 == 0) {
  1836.     clrmem_(&tabinf_1.lx2);
  1837.     }
  1838. /*<       call clrmem(lvntmp) >*/
  1839.     clrmem_(&tabinf_1.lvntmp);
  1840. /*<       if ((mode.eq.1).and.(modedc.eq.3)) go to 1020 >*/
  1841.     if (status_1.mode == 1 && status_1.modedc == 3) {
  1842.     goto L1020;
  1843.     }
  1844. /*<       if(nolx3.eq.0) call clrmem(lx3) >*/
  1845.     if (nolx3 == 0) {
  1846.     clrmem_(&tabinf_1.lx3);
  1847.     }
  1848. /*<       if (mode.eq.1) go to 1020 >*/
  1849.     if (status_1.mode == 1) {
  1850.     goto L1020;
  1851.     }
  1852. /*<       call clrmem(ltd) >*/
  1853.     clrmem_(&tabinf_1.ltd);
  1854. /*<       if (iord.eq.1) go to 1020 >*/
  1855.     if (status_1.iord == 1) {
  1856.     goto L1020;
  1857.     }
  1858. /*<       if (method.eq.1) go to 1020 >*/
  1859.     if (status_1.method == 1) {
  1860.     goto L1020;
  1861.     }
  1862. /*<       call clrmem(lx4) >*/
  1863.     clrmem_(&tabinf_1.lx4);
  1864. /*<       if (iord.eq.2) go to 1020 >*/
  1865.     if (status_1.iord == 2) {
  1866.     goto L1020;
  1867.     }
  1868. /*<       call clrmem(lx5) >*/
  1869.     clrmem_(&tabinf_1.lx5);
  1870. /*<       if (iord.eq.3) go to 1020 >*/
  1871.     if (status_1.iord == 3) {
  1872.     goto L1020;
  1873.     }
  1874. /*<       call clrmem(lx6) >*/
  1875.     clrmem_(&tabinf_1.lx6);
  1876. /*<       if (iord.eq.4) go to 1020 >*/
  1877.     if (status_1.iord == 4) {
  1878.     goto L1020;
  1879.     }
  1880. /*<       call clrmem(lx7) >*/
  1881.     clrmem_(&tabinf_1.lx7);
  1882. /*<  1020 call extmem(loutpt,2*numout) >*/
  1883. L1020:
  1884.     i_1 = numout << 1;
  1885.     extmem_(&tabinf_1.loutpt, &i_1);
  1886. /*<  1100 if(ipostp.ne.0) call clrmem(ibuff) >*/
  1887. L1100:
  1888.     if (status_1.ipostp != 0) {
  1889.     clrmem_(&ibuff);
  1890.     }
  1891. /*<       call second(t2) >*/
  1892.     second_(&t2);
  1893. /*<       rstats(loctim)=rstats(loctim)+t2-t1 >*/
  1894.     miscel_1.rstats[loctim - 1] = miscel_1.rstats[loctim - 1] + t2 - t1;
  1895. /*<       return >*/
  1896.     return 0;
  1897. /*<       end >*/
  1898. } /* dctran_ */
  1899.  
  1900. #undef cvalue
  1901. #undef nodplc
  1902. #undef ablnk
  1903. #undef lprn
  1904. #undef subtit
  1905. #undef avltg
  1906. #undef anode
  1907. #undef avfrm
  1908. #undef avhdr
  1909. #undef alett
  1910. #undef aletr
  1911.  
  1912.  
  1913.